perm filename DFUEXP.F4[TMP,LCS] blob
sn#120527 filedate 1974-09-17 generic text, type T, neo UTF8
00100 C ********** DISPLAY OR PLOT OUTPUT **********
00200 SUBROUTINE DPY(F,IY)
00300 DIMENSION H(120)
00400 COMMON/LT/LPTY,JSEE
00500 DIMENSION F(1)
00600 DATA Q/'X'/
00700 IF(JSEE)GO TO 1
00800 TYPE 2
00900 ACCEPT 3,N
01000 IF(N.NE.'Y')RETURN
01100 1 M=72
01200 JR=12
01300 NN=23
01400 IF(LPTY.EQ.5)GO TO 7
01500 M=120
01600 JR=26
01700 NN=51
01800 7 RH=512.0/M
01900 T=1
02000 S=2.0/NN+.001
02100 DO 4 K=1,NN
02200 R=1.-K*S
02300 H(1)='!'
02400 A=' '
02500 IF(K.EQ.JR)A='-'
02600 6 DO 11 L=2,M
02700 11 H(L)=A
02800 J=1
02900 RJ=1
03000 12 DO 9 L=1,M
03100 A=F(J)
03200 IF(A.GT.R.AND.A.LE.T)H(L)=Q
03300 RJ=RJ+RH
03400 9 J=RJ
03500 T=R
03600 4 WRITE(LPTY,20)(H(L),L=1,M)
03700 IF(LPTY.NE.5)RETURN
03800 TYPE 5
03900 ACCEPT 3,N
04000 RETURN
04100 20 FORMAT(1X120A1)
04200 2 FORMAT(' SEE IT? '$)
04300 3 FORMAT(A1)
04400 5 FORMAT(' <CR>=CONTINUE'$)
04500 END
04600
04700 SUBROUTINE PLOTIT(FUNC,EY,P)
04800 COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
04900 1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
05000 DIMENSION FUNC(1)
05100 IF(P.EQ.'P')GO TO 1
05200 IF(P.EQ.0)GO TO 4
05300 Y=1
05400 X=2.
05500 CC IF(P.NE.'X')GO TO 6
05600 CC X=1.5
05700 CC Y=.5
05800 6 CALL PLOTS(K)
05900 P=0
06000 GO TO 40
06100 1 TYPE 2
06200 CALL PLOTS(K)
06300 ACCEPT 3,X
06400 IF(X.EQ.0)X=SZX
06500 IF(X.EQ.0)X=1.
06600 SZX=X
06700 40 SZ=X/5.12
06710 CALL PLOT(0,17.*SZ,-3)
06755 C ABOVE FOR COLGATE PLOTTER.
06800 41 S=0
06900 J=1
07000 RJK=X/8.
07100 CALL SYMBOL(SZ,4.*SZ,RJK,FLNM,0,5)
07200 4 CALL SYMBOL(SZ,-3.*SZ,RJK,B(2,JX),0,3)
07300 CALL PLOT(5.12*SZ,0.,3)
07400 CALL PLOT(0.,0.,2)
07500 CALL PLOT(0.,-2.*SZ,3)
07600 CALL PLOT(0.,2.*SZ,2)
07700
07800 72 CALL PLOT(.01*SZ,FUNC(1)*2.*SZ,3)
07900 DO 73 K=2,512
08000 R=K/100.0
08100 73 CALL PLOT(R*SZ,FUNC(K)*2.*SZ,2)
08200 T=0
08300 Q=Y+5*SZ
08400 IF(J.NE.5)GO TO 5
08500 Q=-S
08600 T=-7*SZ
08700 5 CALL PLOT(Q,T,-3)
08800 S=S+Q
08900 J=J+1
09000 RETURN
09100
09200 2 FORMAT(' TYPE SIZE - '$)
09300 3 FORMAT(F)
09400 END